home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / STELNET.ZIP / STAMINA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-01  |  5.0 KB  |  195 lines

  1. unit Stamina;
  2.  
  3. interface
  4.  
  5. uses
  6.     Windows, SysUtils, OLE2;
  7.  
  8. function szFormatLastError( dwLastError: DWORD;
  9.      szOutputBuffer: PChar; dwSizeofOutputBuffer: DWORD ): PChar;
  10.  
  11. function FormatLastError( dwLastError: DWORD ): string;
  12.  
  13. function DelphiIsRunning : boolean;
  14.  
  15. {C++ routines}
  16. function iscntrl( ch: char ):Boolean;
  17. function isalpha( ch: char ):Boolean;
  18. function isdigit( ch: char ):Boolean;
  19. function strtoul(pszBuffer: PChar; var ppszBuffer: PChar; Base: Integer): Integer;
  20. procedure mbstowcs( szw: POleStr; m_pszPath: PChar; len: Integer{sizeof(szw)});
  21.  
  22. const
  23.     MAXOUTPUTSTRINGLENGTH = 4096;
  24.  
  25. implementation
  26.  
  27. function MAKELANGID( usPrimaryLanguage, usSubLanguage: Byte ): WORD;
  28. begin
  29.     Result := ((usSubLanguage shl 10) + usPrimaryLanguage);
  30. end;
  31.  
  32. function FormatLastError( dwLastError: DWORD ): string;
  33. var
  34.     szTemp:    PChar;
  35. begin
  36.     szTemp := szFormatLastError( dwLastError, nil, 0 );
  37.     Result := StrPas( szTemp );
  38.     LocalFree( Integer(szTemp) );
  39. end;
  40.  
  41. //
  42. //  FUNCTION: FormatLastError(DWORD, LPSTR, DWORD)
  43. //
  44. //  PURPOSE: Pretty print a system error to a string.
  45. //
  46. //  PARAMETERS:
  47. //    dwLastError          - Actual error code to decipher.
  48. //    szOutputBuffer       - String buffer to pretty print to.
  49. //    dwSizeofOutputBuffer - Size of String buffer.
  50. //
  51. //  RETURN VALUE:
  52. //    Returns the buffer printed to.
  53. //
  54. //  COMMENTS:
  55. //    If szOutputBuffer isn't big enough to hold the whole string,
  56. //    then the string gets truncated to fit the buffer.
  57. //
  58. //    If szOutputBuffer == NULL, then dwSizeofOutputBuffer
  59. //    is ignored, a buffer 'big enough' is LocalAlloc()d and
  60. //    a pointer to it is returned.  However, its *very* important
  61. //    that this pointer be LocalFree()d by the calling application.
  62. //
  63. //
  64. function szFormatLastError( dwLastError: DWORD;
  65.      szOutputBuffer: PChar; dwSizeofOutputBuffer: DWORD ): PChar;
  66. var
  67.     dwRetFM,
  68.     dwFlags:                     DWORD;
  69.     dwGetLastError:             DWORD;
  70.     szFormatMessageError:    LPSTR;
  71. begin
  72.     dwFlags := FORMAT_MESSAGE_FROM_SYSTEM;
  73.  
  74.      // Should we allocate a buffer?
  75.      if szOutputBuffer = nil then
  76.      begin
  77.             // Actually, we make FormatMessage allocate the buffer, if needed.
  78.             dwFlags := dwFlags + FORMAT_MESSAGE_ALLOCATE_BUFFER;
  79.  
  80.             // minimum size FormatMessage should allocate.
  81.             dwSizeofOutputBuffer := 1;
  82.      end;
  83.  
  84.      // Make FormatMessage pretty print the system error.
  85.      dwRetFM := FormatMessage(
  86.             dwFlags, nil, dwLastError,
  87.             MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_US),
  88.             PAnsiChar(@szOutputBuffer), dwSizeofOutputBuffer,
  89.             nil);
  90.  
  91.      // FormatMessage failed to print the error.
  92.      if dwRetFM = 0 then
  93.      begin
  94.           dwGetLastError := GetLastError;
  95.  
  96.           // If we asked FormatMessage to allocate a buffer, then it
  97.           // might have allocated one.  Lets be safe and LocalFree it.
  98.           if (dwFlags and FORMAT_MESSAGE_ALLOCATE_BUFFER) <> 0 then
  99.           begin
  100.                 LocalFree(HLOCAL(szOutputBuffer));
  101.  
  102.                 szOutputBuffer := PChar(LocalAlloc( LPTR, MAXOUTPUTSTRINGLENGTH ));
  103. {                dwSizeofOutputBuffer := MAXOUTPUTSTRINGLENGTH;}
  104.  
  105.                 if szOutputBuffer = nil then
  106.                 begin
  107.                      OutputDebugString( 'Out of memory trying to FormatLastError' );
  108.                      result := nil;
  109.                      Exit;
  110.                 end;
  111.           end;
  112.  
  113.           szFormatMessageError := PChar(IntToStr(dwGetLastError));{
  114.                 FormatLastError( dwGetLastError, nil, 0 );}
  115.  
  116.           if szFormatMessageError = nil then
  117.           begin
  118.                 Result := nil;
  119.                 Exit;
  120.           end;
  121.  
  122.             wsprintf(szOutputBuffer,
  123.                 PChar('FormatMessage failed on error '+IntToStr(dwLastError)+' for the following reason: '+
  124.                     szFormatMessageError) );
  125.  
  126.           LocalFree( HLOCAL(szFormatMessageError) );
  127.      end;
  128.  
  129.      Result := szOutputBuffer;
  130. end;
  131.  
  132. function DelphiIsRunning : boolean;
  133. var
  134.     H1, H2, H3, H4 : Hwnd;
  135. const
  136.     A1 : array[0..12] of char = 'TApplication'#0;
  137.     A2 : array[0..15] of char = 'TAlignPalette'#0;
  138.     A3 : array[0..18] of char = 'TPropertyInspector'#0;
  139.     A4 : array[0..11] of char = 'TAppBuilder'#0;
  140.     T1 : array[0..6] of char = 'Delphi'#0;
  141. begin
  142.     H1 := FindWindow(A1, nil{T1});
  143.     H2 := FindWindow(A2, nil);
  144.     H3 := FindWindow(A3, nil);
  145.     H4 := FindWindow(A4, nil);
  146.     Result := (H1 <> 0) and (H2 <> 0) and
  147.                         (H3 <> 0) and (H4 <> 0);
  148. end;
  149.  
  150. //
  151. // C++ routines
  152. //
  153. procedure mbstowcs( szw: POleStr; m_pszPath: PChar; len: Integer{sizeof(szw)});
  154. begin
  155. MultiByteToWideChar(
  156.         CP_ACP,    // ANSI code page
  157.         0,    // character-type options
  158.         m_pszPath,    // address of string to map
  159.         Length(m_pszPath),     // number of characters in string
  160.         szw,  // address of wide-character buffer
  161.         len      // size of buffer
  162.      );
  163. end;
  164.  
  165. function iscntrl( ch: char ):Boolean;
  166. begin
  167.     Result := ch in [#0..#31,#127];
  168. end;
  169.  
  170. function isalpha( ch: char ):Boolean;
  171. begin
  172.     Result := ch in ['a'..'z','A'..'Z'];
  173. end;
  174.  
  175. function isdigit( ch: char ):Boolean;
  176. begin
  177.     Result := ch in ['0'..'9'];
  178. end;
  179.  
  180. function strtoul(pszBuffer: PChar; var ppszBuffer: PChar; Base: Integer): Integer;
  181. var
  182.     str: string;
  183. begin
  184.     str := '';
  185.     while isdigit( pszBuffer^ ) do
  186.     begin
  187.         str := str + pszBuffer^;
  188.         Inc( pszBuffer );
  189.     end;
  190.     ppszBuffer := pszBuffer;
  191.     Result := StrToInt( str );
  192. end;
  193.  
  194. end.
  195.